home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 005 / pi.arc / P&I.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1987-01-17  |  4.4 KB  |  184 lines
  1. PROGRAM PI;
  2.  
  3. {This program calculates the Monthly Principal and Interest payment
  4.  for a loan. The user enters the Principal borrowed, Interest Rate,
  5.  and the number of months in the payback period.}
  6.  
  7. {Written by Gerald F. Seidl on 01/17/87
  8.  Compuserve 72307,154
  9.  Delphi     GSEIDL}
  10.  
  11. TYPE
  12. string79         = string[79];
  13. string2          = string[2];
  14.  
  15. CONST
  16.           black  = 0;
  17.           blue   = 1;
  18.           green  = 2;
  19.           cyan   = 3;
  20.           red    = 4;
  21.           magenta= 5;
  22.           brown  = 6;
  23.           white  = 15;
  24.  
  25. VAR
  26.       X,X1,Z,A,R : real;
  27.                t : integer;
  28.          running : boolean;
  29.   DAY,MONTH,YEAR,
  30.      HOUR,MINUTE : integer;
  31.           AMORPM : string2;
  32.  
  33. {****************************************************}
  34. Procedure Put_String (OUT_STRING : STRING79;
  35.                LINE, COL, ATTRIB : INTEGER);
  36.  
  37. Begin
  38.   GOTOXY(COL,LINE);
  39.   WRITE(OUT_STRING);
  40. End;
  41.  
  42. {****************************************************}
  43. Procedure Put_Real (NUMBER : real;
  44.          LINE,COL,ATTRIB,NUM_LENGTH,NUMDEC: integer);
  45.  
  46. Var
  47. TEMP_STR: STRING79;
  48.  
  49. Begin
  50.   STR (NUMBER:NUM_LENGTH:NUMDEC,TEMP_STR);
  51.   PUT_STRING(TEMP_STR,LINE,COL,ATTRIB);
  52. End;
  53.  
  54. {****************************************************}
  55. Function YES : boolean;
  56.  
  57. Var CH : CHAR;
  58.  
  59. Begin
  60.   read(CH);
  61.   if ch in ['Y','y'] then yes:= true else yes:=false
  62. End;
  63.  
  64. {****************************************************}
  65. Function MONOCHROME : boolean;
  66.  
  67. TYPE reg_pack = record
  68.                   AX,BX,CX,DX,BP,SI,DI,DS,ES,FLAGS : INTEGER
  69.                 end;
  70.  
  71. VAR regs : reg_pack;
  72.  
  73. Begin
  74.   intr(17,regs);
  75.   if ((regs.ax) and $0030) = $30 then MONOCHROME := TRUE
  76.     else MONOCHROME := false
  77. End;
  78.  
  79. {****************************************************}
  80. Procedure Get_Date (var DAY,MONTH,YEAR : integer);
  81.  
  82. TYPE reg_pack = record
  83.                   AX,BX,CX,DX,BP,SI,DI,DS,ES,FLAGS : INTEGER
  84.                 end;
  85. VAR
  86.      regs : reg_pack;
  87.  
  88. Begin
  89.   With REGS Do
  90.     Begin
  91.       AX := $2A00;
  92.       MSDos(REGS);
  93.       Day   :=Lo(DX);
  94.       Month :=Hi(DX);
  95.       Year  :=CX;
  96.      End;
  97. End;
  98.  
  99. {***************************************************}
  100. Procedure Get_Time (var HOURS,MINUTES : integer);
  101.  
  102. TYPE reg_pack = record
  103.                   AX,BX,CX,DX,BP,SI,DI,DS,ES,FLAGS : INTEGER
  104.                 end;
  105. VAR
  106.      regs     : reg_pack;
  107.  
  108. Begin
  109.   With REGS Do
  110.    Begin
  111.      AX:=$2C00;
  112.      MSDos(REGS);
  113.      HOURS:=Hi(CX);
  114.      MINUTES:=Lo(CX);
  115.    End;
  116. End;
  117.  
  118. {************ MAIN PROGRAM SECTION ***************}
  119.  
  120. Begin
  121.   RUNNING:=true;
  122.   AMORPM:='am';
  123.   If not MONOCHROME then textmode(c80);
  124.   If not MONOCHROME then textbackground(black);
  125.   While RUNNING Do
  126.   Begin
  127.     ClrScr;
  128.     Get_Date(DAY,MONTH,YEAR);
  129.     Get_Time(HOUR,MINUTE);
  130.     If not MONOCHROME then textcolor(cyan);
  131.     GotoXY(1,2);
  132.     write(MONTH,'/',DAY,'/',YEAR);
  133.     GotoXY(19,2);
  134.     Write('Calculate Monthly P & I payment for a loan');
  135.     GotoXY(72,2);
  136.     if HOUR > 12 then
  137.       Begin
  138.         HOUR:=HOUR-12;
  139.         AMORPM:='pm';
  140.       End;
  141.     WriteLN(HOUR,':',MINUTE,AMORPM);
  142.     GotoXY(0,3);
  143.     WriteLN('------------------------------------------------------------------------------');
  144.     Repeat
  145.       GotoXY(19,5);
  146.       If not MONOCHROME then TextColor(green);
  147.       Write('Please enter to amount to borrow : ');
  148.       If not MONOCHROME then TextColor(cyan);
  149.       Read(A);
  150.     Until A>=1;
  151.     Repeat
  152.       GotoXY(19,7);
  153.       If not MONOCHROME then TextColor(green);
  154.       Write('                   Interest Rate : ');
  155.       If not MONOCHROME then TextColor(cyan);
  156.       Read(R);
  157.     Until R>=1;
  158.     Repeat
  159.       GotoXY(19,9);
  160.       If not MONOCHROME then TextColor(green);
  161.       Write('                Term (in months) : ');
  162.       If not MONOCHROME then TextColor(cyan);
  163.       Read(T);
  164.     Until t>=1;
  165.     X:=((R/12)*0.01);
  166.     X1:=1/((1-(1/(exp(T*ln(1+X)))))/(X*T*A));
  167.     Z:=int(X1/T*100+0.99)*0.01;
  168.     GotoXY(19,12);
  169.     If not MONOCHROME then TextColor(green);
  170.     Write('This would be your P & I payment :');
  171.     If not MONOCHROME then TextColor(cyan);
  172.     Put_Real(z,12,54,0,5,2);
  173.     GotoXY(19,20);
  174.     If not MONOCHROME then TextColor(green);
  175.     Write('Do you want to enter another loan? (Y/N): ');
  176.     If not MONOCHROME then TextColor(cyan);
  177.     If YES then running:= TRUE else running:=FALSE;
  178.  
  179.   End;{while RUNNING}
  180.  
  181.   if not MONOCHROME then textmode;
  182. End. {main program}
  183.  
  184.